home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / VBASIC / PHONE.ZIP / PHONE.TXT
Encoding:
Text File  |  1996-07-18  |  4.2 KB  |  271 lines

  1. The phone book example was wrote in vb4 16bit
  2.  
  3. This code sets up a data file (redrum.dat) and shows how to create , remove
  4. search ,etc..... for your records 
  5.  
  6.       dIsClaImEr--- I am not resposible for anything blahblahblah 
  7.  
  8.  
  9. 'create a module and name it
  10. 'The Module
  11. Option Explicit
  12.  
  13. Type info
  14.  
  15. name As String * 20
  16. number As String * 10
  17.  
  18. End Type
  19.  
  20.  
  21.  
  22.  
  23.  
  24.  
  25.  
  26. 'THE form
  27.  
  28. Option Explicit
  29.  
  30. 'declares the main variables
  31.  
  32. Dim A As info
  33. Dim filenum As Integer
  34. Dim recordlen As Long
  35. Dim currentrecord As Long
  36. Dim lastrecord As Long
  37.  
  38.  
  39.  
  40. Public Sub SaveCurrentRecord()
  41. 'fills a with the current info
  42.  A.name = txtname
  43.  A.number = txtnumber
  44.  
  45. 'saves to the currentrecord
  46.  
  47.  Put #filenum, currentrecord, A
  48.  
  49.  
  50.  
  51. End Sub
  52.  
  53. Public Sub ShowCurrentrecord()
  54.  
  55.   Get #filenum, currentrecord, A
  56.  
  57. 'display the data
  58.  
  59.   txtname = Trim(A.name)
  60.   txtnumber = Trim(A.number)
  61.  
  62. End Sub
  63.  
  64.  
  65.  
  66. Private Sub cmdDel_Click()
  67. 'delete the record /.... i copy the redrum.dat except for the current record then delete the txt and restore causing a deleted record
  68.  
  69. Dim dirresult
  70. Dim tmpfilenum
  71. Dim tmpA As info
  72. Dim recnum As Long
  73. Dim tmprecnum As Long
  74. '
  75. 'confirm the deletion
  76. If MsgBox("Delete this name/number?", 4) <> 6 Then
  77.  txtname.SetFocus
  78.  Exit Sub
  79. End If
  80.  
  81. If Dir("redrum.tmp") = "redrum.tmp" Then
  82.  Kill "redrum.tmp"
  83. End If
  84. '
  85. '
  86.  tmpfilenum = FreeFile
  87.  Open "redrum.tmp" For Random As tmpfilenum Len = recordlen
  88.  recnum = 1
  89.  tmprecnum = 1
  90.  
  91. Do While recnum < lastrecord + 1
  92.  If recnum <> currentrecord Then
  93.  
  94. Get #filenum, recnum, tmpA
  95. Put #tmpfilenum, tmprecnum, tmpA
  96. tmprecnum = tmprecnum + 1
  97.  End If
  98.  
  99. recnum = recnum + 1
  100. Loop
  101.  
  102. 'delete the original file
  103. Close filenum
  104. Kill "redrum.dat"
  105.  
  106. Close tmpfilenum
  107. 'rename the new file
  108. Name "redrum.tmp" As "redrum.dat"
  109. 'reopen it
  110. filenum = FreeFile
  111. Open "redrum.dat" For Random As filenum Len = recordlen
  112.  
  113. lastrecord = lastrecord - 1
  114.  
  115. If lastrecord = 0 Then
  116.  lastrecord = 1
  117.  
  118.  
  119.  If currentrecord > lastrecord Then
  120.  currentrecord = lastrecord
  121.  End If
  122. End If
  123.  
  124. ShowCurrentrecord
  125.  
  126. txtname.SetFocus
  127.  
  128.  
  129. End Sub
  130.  
  131.  
  132. Private Sub cmdExit_Click()
  133. End
  134.  
  135. End Sub
  136.  
  137.  
  138. Private Sub cmdNew_Click()
  139. 'saves the current info
  140.  SaveCurrentRecord
  141. 'add a blank record
  142.  lastrecord = lastrecord + 1
  143.  A.name = ""
  144.  A.number = ""
  145.  
  146. Put #filenum, lastrecord, A
  147.  
  148. currentrecord = lastrecord
  149.  
  150. ShowCurrentrecord
  151.  
  152. txtname.SetFocus
  153.  
  154.  
  155.  
  156.  
  157.  
  158. End Sub
  159.  
  160. Private Sub cmdNext_Click()
  161.  
  162. If currentrecord = lastrecord Then
  163.  MsgBox "This is the last record in your list"
  164. Else
  165.  SaveCurrentRecord
  166.  currentrecord = currentrecord + 1
  167.  ShowCurrentrecord
  168. End If
  169.  
  170. End Sub
  171.  
  172.  
  173. Private Sub cmdPrev_Click()
  174.  
  175. If currentrecord = 1 Then
  176.  MsgBox "This is the first record in your list"
  177. Else
  178. SaveCurrentRecord
  179. currentrecord = currentrecord - 1
  180. ShowCurrentrecord
  181. End If
  182.  
  183. End Sub
  184.  
  185.  
  186. Private Sub cmdSearch_Click()
  187.  
  188. Dim nametosearch As String
  189. Dim found As Integer
  190. Dim recnum As Long
  191. Dim tmpA As info
  192.  
  193. 'input box for the name to search for
  194.  
  195. nametosearch = InputBox("Name to search for?", "sEarcH eNgInE")
  196.  
  197. 'if the user enters null exit sub'
  198.  
  199. If nametosearch = "" Then
  200.  txtname.SetFocus
  201.  Exit Sub
  202. End If
  203.  
  204. 'use th UCASE function to convert the letters to UPPERCASE
  205. nametosearch = UCase(nametosearch)
  206. 'found flag = false
  207.   
  208.   found = False
  209.  
  210. 'search for the name
  211. For recnum = 1 To lastrecord
  212.  Get #filenum, recnum, tmpA
  213.     If nametosearch = UCase(Trim(tmpA.name)) Then
  214.     found = True
  215.     Exit For
  216.     
  217.   End If
  218. Next
  219.  
  220. 'display the name u searced for
  221.  
  222. If found = True Then
  223.  SaveCurrentRecord
  224.  currentrecord = recnum
  225.  ShowCurrentrecord
  226. Else
  227.  MsgBox "" + nametosearch + "Not found"
  228. End If
  229.  
  230. txtname.SetFocus
  231.  
  232.  
  233.  
  234. End Sub
  235.  
  236. Private Sub Form_Load()
  237.  
  238. 'calculate the L.O.F
  239. recordlen = Len(A)
  240. 'get the next file number
  241. filenum = FreeFile
  242. 'open the file
  243. Open "redrum.dat" For Random As filenum Len = recordlen
  244. 'updaate the record
  245. currentrecord = 1
  246. 'find the last record
  247. lastrecord = FileLen("redrum.dat") / recordlen
  248.  
  249. If lastrecord = 0 Then
  250. lastrecord = 1
  251. End If
  252.  
  253. 'execute the ShowCurrentrecord procedure
  254.  
  255. ShowCurrentrecord
  256.  
  257.  
  258.  
  259. End Sub
  260.  
  261.  
  262. Private Sub Form_Unload(Cancel As Integer)
  263. Close filenum
  264.  
  265. End Sub
  266.  
  267.  
  268.  
  269.  
  270.  
  271.